home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vol_ser / volserno.bas < prev    next >
Encoding:
BASIC Source File  |  1993-07-04  |  6.0 KB  |  163 lines
  1. Option Explicit
  2.  
  3. Global Const szgNul = ""
  4.  
  5. Type MhMuscleType
  6.     'MhMuscleType definition
  7.     'Copyright 1990-1993 MicroHelp, Inc.  ALL RIGHTS RESERVED.
  8.     'Don't alter the number or order of these elements without
  9.     'also modifying ALL assembler code!
  10.     Shift                   As Integer
  11.     Scan                    As Integer
  12.     Ascii                   As Integer
  13.     Lb                      As Integer
  14.     Rb                      As Integer
  15.     RbTerminateAscii        As Integer
  16.     RbTerminateScan         As Integer
  17.     CursorNormalStart       As Integer
  18.     CursorNormalEnd         As Integer
  19.     CursorInsertStart       As Integer
  20.     CursorInsertEnd         As Integer
  21.     MonitorSeg              As Integer
  22.     MonitorType             As Integer
  23.     MonitorRows             As Integer
  24.     MonitorColumns          As Integer
  25.     VideoMode               As Integer
  26.     MouseInstalled          As Integer
  27.     Verify                  As Integer
  28.     CaseSens                As Integer
  29.     TableSize               As Integer
  30.     DontRestore             As Integer
  31.     TopRow                  As Integer
  32.     LeftColumn              As Integer
  33.     BottomRow               As Integer
  34.     RightColumn             As Integer
  35.     BoxType                 As Integer
  36.     BoxColor                As Long
  37.     ShadowColor             As Long
  38.     ShadowPosition          As Integer
  39.     FillColor               As Long
  40.     InverseColor            As Long
  41.     HighlightColor          As Long
  42.     NormalColor             As Long
  43.     TitleColor              As Long
  44.     WordWrapWidth           As Integer
  45.     LastElement             As Integer
  46.     TabStop                 As Integer
  47.     SelectionWrap           As Integer
  48.     DeselectColor           As Long
  49.     DeselectInverseColor    As Long
  50.     BarColor                As Long
  51.     InverseBarColor         As Long
  52.     KeyHighlightColor       As Long
  53.     DescriptionRow          As Integer
  54.     DescriptionColor        As Long
  55.     MenuNumber              As Integer
  56.     SelectionNumber         As Integer
  57.     Range                   As Integer
  58.     Month                   As Integer
  59.     Day                     As Integer
  60.     Year                    As Integer
  61.     Startyear               As Integer
  62.     DisplayMode             As Integer
  63.     ForceRead               As Integer
  64.     MemSeg                  As Integer
  65.     MemOffset               As Integer
  66.     MaxFiles                As Integer
  67.     Fillcharacter           As Integer
  68.     SoundOff                As Integer
  69.     Gen1                    As Integer
  70.     Gen2                    As Integer
  71.     Gen3                    As Integer
  72.     Gen4                    As Integer
  73.     ShadowColumns           As Integer
  74.     ShadowRows              As Integer
  75.     SnowCheck               As Integer
  76.     Drive                   As Integer
  77.     FileAttributes          As Integer
  78.     DosMajorVersion         As Integer
  79.     DosMinorVersion         As Integer
  80.     MouseStatus             As Integer
  81.     ExitIfMouseOutside      As Integer
  82.     HugeArrayNum            As Integer
  83.     AutoTerminate           As Integer
  84.     DefaultInsertState      As Integer
  85.     GeneralCount            As Integer
  86.     GenLong1                As Long
  87.     GenLong2                As Long
  88.     Bytes                   As Long
  89.     CurrentPos              As Integer
  90.     NoDestroy               As Integer
  91. End Type 'MhMuscleType
  92.  
  93. Declare Function SAdd% Lib "Muscle.vbx" (Varbl$)
  94. Declare Function SSeg% Lib "Muscle.vbx" (Varbl$)
  95. Declare Function MhASCIIMid% Lib "Muscle.vbx" (A$, ByVal Position%)
  96. Declare Function MhDirectoryExists% Lib "Muscle.vbx" (ByVal DirSpec$)
  97. Declare Function MhDiskReadAbsolute% Lib "Muscle.vbx" (MuVar As MhMuscleType)
  98. Declare Function MhEcode% Lib "Muscle.vbx" ()
  99. Declare Function MhHexStrInt$ Lib "Muscle.vbx" (ByVal Fmt%, IntVal%)
  100. Declare Function MhMuscleErrorText$ Lib "Muscle.vbx" (ByVal ErrorNum%)
  101. Declare Sub MhECodeSet Lib "Muscle.vbx" (ByVal Valu%)
  102.  
  103. Dim MuVar As MhMuscleType
  104.  
  105. Private Sub MhErrorMessage (szSuffix As String)
  106.     Dim fMhErrorCode As Integer
  107.     Dim szMessage As String
  108.  
  109.     fMhErrorCode = MhEcode()
  110.     If fMhErrorCode > 0 Then
  111.         szMessage = MhMuscleErrorText$(fMhErrorCode)
  112.     End If
  113.     If Len(szMessage) = 0 Then
  114.         szMessage = "Error # " + Str$(fMhErrorCode)
  115.     End If
  116.     MsgBox szMessage + szSuffix
  117. End Sub
  118.  
  119. Function VolSerialNo (szDrive As String) As String
  120.  
  121.     Dim fMhErrorCode As Integer
  122.     Dim iByte As Integer
  123.     Dim iCounter As Integer
  124.     Dim szBuffer As String
  125.     Dim szByte As String
  126.     Dim szTemp As String
  127.  
  128.     If Len(szDrive) Then
  129.         szDrive = UCase$(Left$(szDrive, 1))
  130.         If Not MhDirectoryExists(szDrive + ":\") Then
  131.             MsgBox "Disk not found... try again!"
  132.             Exit Function
  133.         Else
  134.             MuVar.Drive = Asc(szDrive) - 64     'Drive number A=1, etc
  135.             MuVar.GenLong1 = 0                  'Boot sector
  136.             MuVar.GeneralCount = 1              'Read 1 sector
  137.             szBuffer = String$((2 * 512), 0)    'Create a buffer
  138.             MuVar.MemSeg = SSeg(szBuffer)       'Point to it
  139.             MuVar.MemOffset = SAdd(szBuffer)
  140.             fMhErrorCode = MhDiskReadAbsolute(MuVar)
  141.             If fMhErrorCode Then
  142.                 MhECodeSet (MhEcode() Mod 256)
  143.                 MhErrorMessage " while reading sectors"
  144.                 Exit Function
  145.             Else
  146.                 'The volume serial number is 4 hex numbers long
  147.                 'The first hex number is in the last sector
  148.                 'So read the serial number in backwards
  149.                 szTemp = szgNul
  150.                 For iCounter = 43 To 40 Step -1
  151.                     iByte = MhASCIIMid(szBuffer, iCounter)
  152.                     szByte = Right$(MhHexStrInt(1, iByte), 2)
  153.                     szTemp = szTemp + szByte
  154.                     'Add the hyphen that DOS displays
  155.                     If iCounter = 42 Then szTemp = szTemp & "-"
  156.                 Next
  157.                 VolSerialNo = szTemp
  158.             End If
  159.         End If
  160.     End If
  161. End Function
  162.  
  163.